#include <unistd.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/time.h>
#include <fcntl.h>
#include "k2l.h"

#define SYMTAB_REF(n) K2L_CAST(&s_reserved_symtab[n])
enum {
	#include "k2l_symenum.h"
};
static k2l_sexp_ref ___lambda(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp);
static int memcnt = 0;
static const k2l_int s_reserved_symtab_num;
static k2l_symbol_t s_reserved_symtab[];
static k2l_sexp_ref SYSPRIV_END_OF_FILE  = SYSPRIVF_DEF(0);
static k2l_sexp_ref SYSPRIV_END_OF_LIST  = SYSPRIVF_DEF(0);
static k2l_sexp_ref SYSPRIV_CONS_DOT     = SYSPRIVF_DEF(0);
static k2l_sexp_ref SYSPRIV_COMMA        = SYSPRIVF_DEF(0);
static k2l_sexp_ref SYSPRIV_COMMA_AT     = SYSPRIVF_DEF(0);
static k2l_sexp_ref SYSPRIV_AND_REST     = SYSPRIVF_DEF(0);
static k2l_sexp_ref SYSPRIV_AND_KEY      = SYSPRIVF_DEF(0);
static k2l_sexp_ref SYSPRIV_AND_OPTIONAL = SYSPRIVF_DEF(0);
static k2l_sexp_ref retblk = SYSPRIVF_DEF(K2L_SYS_TYPE_LONGJMP);
static k2l_sexp_ref gotagb = SYSPRIVF_DEF(K2L_SYS_TYPE_LONGJMP);
static k2l_sexp_ref g_symtab  = K2L_NIL; //K2L_CAST(&(k2l_hashtab_t)DECLARE_HASHTAB(K2L_CAST(&g_k2l_fn_stringeq)));
static k2l_sexp_ref g_keyword = K2L_NIL; //K2L_CAST(&(k2l_hashtab_t)DECLARE_HASHTAB(K2L_CAST(&g_k2l_fn_stringeq)));
k2l_type_t k2l_type_sequence_base = {NULL, SYMTAB_REF(K2L_SYM_SEQUENCE), NULL, NULL};
k2l_type_t k2l_type_callee_base = {NULL, SYMTAB_REF(K2L_SYM_CALLEE), NULL, NULL};
k2l_type_t k2l_type_stream_base = {NULL, SYMTAB_REF(K2L_SYM_STREAM), NULL, NULL};
k2l_type_t k2l_type_specialop = {NULL, SYMTAB_REF(K2L_SYM_SPECIALsOPERATOR), NULL, NULL};
k2l_type_t k2l_type_syspriv   = {NULL, SYMTAB_REF(K2L_SYM_SYSTEMsPRIVATE), NULL, NULL};
k2l_type_t k2l_type_imms[] = {{NULL, SYMTAB_REF(K2L_SYM_NULL), NULL, NULL},
							  {NULL, SYMTAB_REF(K2L_SYM_INTEGER), NULL, NULL},
							  {NULL, SYMTAB_REF(K2L_SYM_CHARACTER), NULL, NULL},
							  {NULL, SYMTAB_REF(K2L_SYM_UNDEFINED), NULL, NULL},};
k2l_filedesc_t g_k2l_stdin  = {{0, (k2l_type_t*)&k2l_type_filedesc}, STDIN_FILENO, 0, 0};
k2l_filedesc_t g_k2l_stdout = {{0, (k2l_type_t*)&k2l_type_filedesc}, STDOUT_FILENO, 0, 0};
const k2l_sexp_ref g_k2l_t = {&(k2l_sobj_t){0, &(k2l_type_t){NULL, SYMTAB_REF(K2L_SYM_BOOLEAN), NULL, NULL}}};
#define K2L_SYMTAB (is_nil(g_symtab)? (g_symtab=new_hashtab(113)): g_symtab)
#define K2L_KEYWORD (is_nil(g_keyword)? (g_keyword=new_hashtab(113)): g_keyword)

#ifdef _K2L_MAIN
int main(int argc, char **argv) { return k2l_repl(argc, argv); }
#endif

k2l_sexp_ref sexp_ref_up(k2l_sexp_ref p)
{ (void)(!is_imm(p) && SOBJ_REF(p) && SOBJ_REF(p)++); return p; }

k2l_sexp_ref sexp_ref_down(k2l_sexp_ref p)
{
	if (!is_imm(p) && SOBJ_REF(p) && --SOBJ_REF(p) == 0 && SOBJ_TYPE(p) && SOBJ_TYPE(p)->release) {
		SOBJ_TYPE(p)->release(p);
		return K2L_UNDEF;
	}
	return p;
}

static void disp_sexp(k2l_sexp_ref p, FILE *fp)
{
	if (is_imm_char(p))           fprintf(fp, "#\\%c", imm_char(p));
	else if (is_imm_int(p))       fprintf(fp, "%d", imm_int(p));
	else if (is_nil(p))           fprintf(fp, "NIL");
	else if (is_undef(p))         fprintf(fp, "#\\UNDEF");
	else if (is_imm(p))           fprintf(fp, "i%d", p.w);
	else if (is_t(p))             fputc('T', fp);
	else if (is_symbol(p))        fprintf(fp, (is_keyword(p)? ":%s": "%s"), STRING_HEAD(SYMBOL_NAME(p)));
	else if (is_string(p))        fprintf(fp, "\"%s\"", STRING_HEAD(p));
	else if (is_aborted(p))       fprintf(fp, "#<ABORTED: %s>", STRING_HEAD(SYS_PRIVP(p)));
	else if (is_lambdafn(p)) {
		fprintf(fp, "#<FUNCTION %s: ", STRING_HEAD(LAMBDA_NAME(p)));
		fflush(stdout); disp_sexp(LAMBDA_DEF(p), fp);
	}else if (is_cons(p)) {
		if (CONS_CAR(p).w == SYMTAB_REF(K2L_SYM_QUOTE).w) {
			fputc('\'', fp);
			disp_sexp(CONS_SECOND(p), fp);
		} else {
			fputc('(', fp);
			for (; is_cons(CONS_CDR(p)); p = CONS_CDR(p)) {
				disp_sexp(CONS_CAR(p), fp);
				fputc(' ', fp);
			}
			disp_sexp(CONS_CAR(p), fp);
			if (!is_nil(CONS_CDR(p))) {
				fprintf(fp, " . ");
				disp_sexp(CONS_CDR(p), fp);
			}
			fputc(')', fp);
		}
	} else if (is_vector(p)) {
		int i, max = SEQ_LENGTH(p);
		fprintf(fp, "#(");
		for (i=0; i<max; i++) {
			k2l_sexp_ref tmp = sexp_ref_down(SEQ_ELT(p, i));
			disp_sexp(tmp, fp);
			if (i + 1 < max) fputc(' ', fp);
		}
		fputc(')', fp);
	} else fprintf(fp, "#<%s: %d>", STRING_HEAD(SYMBOL_NAME(SOBJ_TYPE(p)->sig)), SOBJ_REF(p));
}

void k2l_disp(k2l_sexp_ref sexp, k2l_sexp_ref stream)
{
	int newfd = dup(FIS_FD(stream));
	FILE *fp = fdopen(newfd, "w");
	disp_sexp(sexp, fp);
	fclose(fp);
}

void k2l_disp_line(k2l_sexp_ref sexp, k2l_sexp_ref stream)
{
	k2l_disp(sexp, stream);
	write(FIS_FD(stream), "\n", 1);
}

k2l_sexp_ref new_sexp(k2l_u32 len, k2l_type_t *type)
{
	k2l_sexp_ref r;
	r.ptr = malloc(len);
	memset(r.ptr, 0, len);
	SOBJ_REF(r) = 1;
	SOBJ_TYPE(r) = type;
	memcnt++;
	return r;
}

static k2l_int k2l_check_arity(k2l_sexp_ref args, k2l_char *sig)
{// "m"->mandatory "o"->optional "r"->rest
	k2l_int idx = 0, len = K2L_STK_LEN(args);
	for (; *sig == 'm' && idx < len; sig++, idx++) ;
	if (*sig == 'm') return -1;
	for (; *sig == 'o' && idx < len; sig++, idx++) ;
	return !(*sig == 'r' || *sig == 'o' || (*sig == 0 && idx >= len));
}

static void free_sexp(k2l_sexp_ref p)
{ free(p.ptr); memcnt--; }
static void del_cons(k2l_sexp_ref p)
{ sexp_ref_down(CONS_CAR(p)); sexp_ref_down(CONS_CDR(p)); free_sexp(p); }

static k2l_sexp_ref nthcdr(k2l_sexp_ref c, k2l_int i)
{
	if (is_nil(c)) return K2L_NIL;
	while (i-- && is_cons(c)) c = CONS_CDR(c);
	return sexp_ref_up(c);
}

static k2l_sexp_ref nth(k2l_sexp_ref c, k2l_int i)
{
	k2l_sexp_ref r = sexp_ref_down(nthcdr(c, i));
	return sexp_ref_up(is_nil(r)? K2L_NIL: CONS_CAR(r));
}

static void cons_rplaca(k2l_sexp_ref self, k2l_int i, k2l_sexp_ref val)
{
	k2l_sexp_ref a = sexp_ref_down(nthcdr(self, i));
	if (!is_cons(a)) return;
	sexp_ref_down(CONS_CAR(a));
	CONS_CAR(a) = sexp_ref_up(val);
}

static k2l_int list_len(k2l_sexp_ref p)
{// if not proper-list, then return -1
	int r = 0;
	for (; is_cons(p); p = CONS_CDR(p), r++) ;
	return is_nil(p)? r: -1;
}

static k2l_sexp_ref list_subseq(k2l_sexp_ref self, k2l_int idx, k2l_int len)
{
	k2l_sexp_ref ret = K2L_NIL, *pret = &ret;
	while (is_cons(self) && idx--) self = CONS_CDR(self);
	for (; is_cons(self) && len--; pret = &CONS_CDR(*pret), self = CONS_CDR(self))
		*pret = new_cons(CONS_CAR(self), K2L_NIL);
	return ret;
}

k2l_type_sequence_t k2l_type_cons = {{&k2l_type_sequence_base, SYMTAB_REF(K2L_SYM_CONS), del_cons, NULL}, list_len, nth, cons_rplaca, list_subseq};
k2l_sexp_ref new_cons(k2l_sexp_ref a, k2l_sexp_ref d)
{
	k2l_sexp_ref r = new_sexp(sizeof(k2l_cons_t), &k2l_type_cons.suqer);
	CONS_CAR(r) = sexp_ref_up(a);
	CONS_CDR(r) = sexp_ref_up(d);
	return r;
}

static k2l_int k2l_vector_len(k2l_sexp_ref vec)
{ return VECTOR(vec)->last == -1 ? VECTOR(vec)->len + k2l_vector_len(VECTOR(vec)->next):
		VECTOR(vec)->last == -2 ? 0: VECTOR(vec)->last+1; }

static k2l_sexp_ref k2l_vector_elt(k2l_sexp_ref self, k2l_int idx)
{
	if (VECTOR(self)->len > idx) return sexp_ref_up(VECTOR(self)->head[idx]);
	return k2l_vector_elt(VECTOR(self)->next, idx - VECTOR(self)->len);
}

static void k2l_vector_set(k2l_sexp_ref self, k2l_int idx, k2l_sexp_ref val)
{
	if (VECTOR(self)->len > idx) {
		sexp_ref_down(VECTOR(self)->head[idx]);
		VECTOR(self)->head[idx] = sexp_ref_up(val);
		if (VECTOR(self)->last != -1 && idx > VECTOR(self)->last) VECTOR(self)->last = idx;
	} else {
		if (is_nil(VECTOR(self)->next)) VECTOR(self)->next = new_vector(2 * VECTOR(self)->len);
		VECTOR(self)->last = -1;
		k2l_vector_set(VECTOR(self)->next, idx - VECTOR(self)->len, val);
	}
}

void CLEAR_STACK(k2l_sexp_ref vec)
{
	sexp_ref_down(VECTOR(vec)->next);
	if (VECTOR(vec)->last != -2) {
		k2l_int i, max = VECTOR(vec)->last == -1? VECTOR(vec)->len: VECTOR(vec)->last+1;
		for (i=0; i<max; i++) sexp_ref_down(VECTOR(vec)->head[i]);
	}
}

static void del_vector(k2l_sexp_ref vec)
{
	CLEAR_STACK(vec);
	free_sexp(vec);
}

static k2l_sexp_ref k2l_vector_subseq(k2l_sexp_ref self, k2l_int idx, k2l_int len)
{
	k2l_sexp_ref ret = new_vector(len);
	while (len--) k2l_vector_set(ret, len, sexp_ref_down(k2l_vector_elt(self, idx + len)));
	return ret;
}

k2l_type_sequence_t k2l_type_vector = {{&k2l_type_sequence_base, SYMTAB_REF(K2L_SYM_VECTOR), del_vector, NULL}, k2l_vector_len, k2l_vector_elt, k2l_vector_set, k2l_vector_subseq};
k2l_sexp_ref new_vector(k2l_int len)
{
	k2l_sexp_ref r = new_sexp(sizeof(k2l_vector_t)+(len-1)*sizeof(k2l_sexp_ref), &k2l_type_vector.suqer);
	VECTOR(r)->len = len; VECTOR(r)->last = -2;
	return r;
}

static int stringeq(k2l_sexp_ref a, k2l_sexp_ref b)
{ return is_string(a) && is_string(b) && 0 == strcmp(STRING_HEAD(a), STRING_HEAD(b)); }
static k2l_int k2l_string_len(k2l_sexp_ref str)
{ return strlen(STRING_HEAD(str)); }
static k2l_sexp_ref k2l_string_elt(k2l_sexp_ref self, k2l_int idx)
{ return idx >= strlen(STRING_HEAD(self))? K2L_NIL: c2ps((STRING_HEAD(self))[idx]); }
static void k2l_string_set(k2l_sexp_ref self, k2l_int i, k2l_sexp_ref chr)
{ (void)(is_imm_char(chr) && STRING_LEN(self) > i && (STRING_HEAD(self)[i] = imm_char(chr))); }

k2l_sexp_ref new_string_buffer(k2l_u32 len)
{
	k2l_sexp_ref r = new_sexp(sizeof(k2l_string_t) + len, &k2l_type_string.suqer);
	STRING_LEN(r) = len;
	STRING_HEAD(r) = (k2l_char*)(((k2l_string_t*)r.ptr) + 1);
	memset(STRING_HEAD(r), 0, len);
	return r;
}

static k2l_sexp_ref k2l_string_subseq(k2l_sexp_ref self, k2l_int idx, k2l_int len)
{
	k2l_sexp_ref ret = new_string_buffer(len + 1);
	strncpy(STRING_HEAD(ret), STRING_HEAD(self)+idx, len);
	return ret;
}

k2l_type_sequence_t k2l_type_string = {{&k2l_type_sequence_base, SYMTAB_REF(K2L_SYM_STRING), free_sexp, NULL}, k2l_string_len, k2l_string_elt, k2l_string_set, k2l_string_subseq};
k2l_sexp_ref new_string(k2l_char *p)
{
	k2l_sexp_ref r = new_string_buffer(1 + strlen(p));
	strcpy(STRING_HEAD(r), p);
	return r;
}

static void del_symbol(k2l_sexp_ref p)
{
	sexp_ref_down(SYMBOL_NAME(p));
	sexp_ref_down(SYMBOL_VALUE(p));
	sexp_ref_down(SYMBOL_FUNCTION(p));
	free_sexp(p);
}

k2l_type_t k2l_type_symbol = { NULL, SYMTAB_REF(K2L_SYM_SYMBOL), del_symbol, NULL };
k2l_sexp_ref new_symbol(k2l_sexp_ref name, k2l_sexp_ref value, k2l_sexp_ref func)
{
	k2l_sexp_ref r = new_sexp(sizeof(k2l_symbol_t), &k2l_type_symbol);
	SYMBOL_NAME(r) = sexp_ref_up(name);
	SYMBOL_VALUE(r) = sexp_ref_up(value);
	SYMBOL_FUNCTION(r) = sexp_ref_up(func);
	return r;
}

static void del_hashtab(k2l_sexp_ref p)
{
	int i;
	for (i=0; i<HASHTAB_LEN(p); i++) {
		k2l_hashtab_ent *x = HASHTAB_TAB(p)[i];
		while (x) {
			sexp_ref_down(K2L_CAST(x->key));
			sexp_ref_down(x->value);
			k2l_hashtab_ent *y = x->next;
			free(x); x = y;
		}
	}
	free_sexp(p);
}

k2l_type_t k2l_type_hashtab = {NULL, SYMTAB_REF(K2L_SYM_HASHTABLE), del_hashtab, NULL};
k2l_sexp_ref new_hashtab(k2l_int len)
{
	k2l_int l = sizeof(k2l_hashtab_t) + (len-1)*sizeof(k2l_hashtab_ent*);
	k2l_sexp_ref r = new_sexp(l, &k2l_type_hashtab);
	HASHTAB_LEN(r) = len;
	return r;
}

static k2l_hash_t hashtab_culc_hash(k2l_char *p)
{
	int i;
	k2l_hash_t h = 0;
	for (i=1; *p; p++, i++) h += (*p) * i * 7;
	return h;
}

static void hashtab_put(k2l_sexp_ref tab, k2l_sexp_ref key, k2l_sexp_ref val)
{
	k2l_hash_t h = hashtab_culc_hash(STRING_HEAD(key));
	k2l_hashtab_ent **p = &HASHTAB_TAB(tab)[h % HASHTAB_LEN(tab)];
	for (; *p; p = &(*p)->next) {
		if (stringeq(key, K2L_CAST((*p)->key))) {
			sexp_ref_down((*p)->value);
			(*p)->value = sexp_ref_up(val);
			return;
		}
	}
	*p = malloc(sizeof(k2l_hashtab_ent));
	memset(*p, 0, sizeof(k2l_hashtab_ent));
	(*p)->key = (k2l_string_t*)sexp_ref_up(key).ptr;
	(*p)->value = sexp_ref_up(val);
}

static k2l_sexp_ref hashtab_get(k2l_sexp_ref tab, k2l_sexp_ref key)
{
	k2l_hash_t h = hashtab_culc_hash(STRING_HEAD(key));
	k2l_hashtab_ent *p = HASHTAB_TAB(tab)[h % HASHTAB_LEN(tab)];
	for (; p; p = p->next)
		if (stringeq(key, K2L_CAST(p->key))) return sexp_ref_up(p->value); 
	return K2L_UNDEF;
}

static void del_env(k2l_sexp_ref p)
{ sexp_ref_down(ENV_PARENT(p)); del_hashtab(p); }

k2l_type_t k2l_type_env = {NULL, SYMTAB_REF(K2L_SYM_ENVIRONMENT), del_env, NULL};
k2l_sexp_ref new_env(k2l_sexp_ref parent)
{
	k2l_sexp_ref r = new_sexp(sizeof(k2l_env_t), &k2l_type_env);
	HASHTAB_LEN(r) = 5;
	ENV_PARENT(r) = sexp_ref_up(parent);
	return r;
}

static void env_put_symbol(k2l_sexp_ref env, k2l_sexp_ref sym)
{ hashtab_put(is_nil(env)? K2L_SYMTAB: env, SYMBOL_NAME(sym), sym); }

static k2l_sexp_ref env_find_symbol_by_name(k2l_sexp_ref env, k2l_sexp_ref name)
{
	k2l_sexp_ref r = K2L_UNDEF;
	while (is_undef(r) && !is_nil(env)) {
		r = hashtab_get(env, name);
		env = ENV_PARENT(env);
	}
	if (is_undef(r)) {
#ifdef _K2L_USE_GPERF
		extern int k2l_get_rsv_index(char*);
		int idx = k2l_get_rsv_index(STRING_HEAD(name));
		if (idx>=0) return K2L_CAST(&s_reserved_symtab[idx]);
#else
		int i;
		for (i = 0; i < s_reserved_symtab_num; i++) {
			if (stringeq(name, SYMBOL_NAME(K2L_CAST(&s_reserved_symtab[i])))) {
				return K2L_CAST(&s_reserved_symtab[i]);
			}
		}
#endif
		r = hashtab_get(K2L_SYMTAB, name);
	}
	return r;
}

static k2l_sexp_ref keyword_put_symbol(k2l_sexp_ref name)
{
	k2l_sexp_ref sym = new_symbol(name, K2L_UNDEF, K2L_UNDEF);
	SOBJ_REF(sym) = 0;
	SYMBOL_FLAGS(sym) = SYMBOL_FLG_KEYWORD;
	SYMBOL_VALUE(sym) = sym;
	hashtab_put(K2L_KEYWORD, name, sym);
	return sym;
}

static k2l_sexp_ref keyword_find_symbol_by_name(k2l_sexp_ref name)
{ return hashtab_get(K2L_KEYWORD, name); }
static k2l_sexp_ref invoke_function(k2l_sexp_ref self, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return (FUNCTION(self))(args, mvp); }
k2l_type_callee_t k2l_type_function = {{&k2l_type_callee_base, SYMTAB_REF(K2L_SYM_SYSTEMsFUNCTION), NULL, NULL}, invoke_function};

static void del_lambdafn(k2l_sexp_ref p)
{
	sexp_ref_down(LAMBDA_LEX(p));
	sexp_ref_down(LAMBDA_NAME(p));
	sexp_ref_down(LAMBDA_DEF(p));
	free_sexp(p);
}

static k2l_sexp_ref k2l_macroexpand_recur(k2l_sexp_ref form, k2l_sexp_ref env)
{
	k2l_sexp_ref *p = &form;
	for (; is_cons(*p); p = &CONS_CDR(*p)) {
		k2l_sexp_ref tmp = CONS_CAR(*p);
		if (is_cons(tmp)) {
			CONS_CAR(*p) = k2l_macroexpand_recur(tmp, env);
			sexp_ref_down(tmp);
		}
	}
	if (is_cons(form) && is_symbol(CONS_CAR(form))) {
		k2l_sexp_ref tmp = sexp_ref_down(env_find_symbol_by_name(env, SYMBOL_NAME(CONS_CAR(form))));
		if (is_symbol(tmp) && is_macro(SYMBOL_FUNCTION(tmp))) {
			k2l_sexp_ref tmp2 = EXPAND_MACRO(SYMBOL_FUNCTION(tmp), CONS_CDR(form));
			k2l_sexp_ref tmp3 = k2l_macroexpand_recur(tmp2, env);
			sexp_ref_down(tmp2);
			return tmp3;
		}
	}
	return sexp_ref_up(form);
}

static void k2l_hook_lambda(k2l_sexp_ref p)
{
	/* expand macro forms */
	k2l_int idx, len = K2L_STK_LEN(LAMBDA_DEF(p));
	for (idx = 1; idx < len; idx++) {
		k2l_sexp_ref tmp = k2l_macroexpand_recur(K2L_STK_GET(LAMBDA_DEF(p), idx), LAMBDA_LEX(p));
		K2L_STK_SET(LAMBDA_DEF(p), idx, tmp); sexp_ref_down(tmp);
	}
}

k2l_sexp_ref new_lambdafn(k2l_sexp_ref env, k2l_sexp_ref name, k2l_sexp_ref def)
{
	k2l_sexp_ref r = new_sexp(sizeof(k2l_lambdafn_t), &k2l_type_lambdafn.suqer);
	LAMBDA_LEX(r) = sexp_ref_up(env);
	LAMBDA_NAME(r) = sexp_ref_up(name);
	LAMBDA_DEF(r) = sexp_ref_up(def);
	k2l_hook_lambda(r);
	return r;
}

static int bind_lambda_list_mandatory(k2l_sexp_ref dyn, k2l_sexp_ref *adef, k2l_sexp_ref args)
{
	k2l_int idx, len = K2L_STK_LEN(args);
	for (idx = 0; is_cons(*adef) && is_symbol(CONS_CAR(*adef)); *adef = CONS_CDR(*adef), idx++) {
		if (idx >= len) return -1; //K2L_ABORT("bind_lambda_list_mandatory: arguments is too few\n");
		k2l_sexp_ref sym = new_symbol(SYMBOL_NAME(CONS_CAR(*adef)), K2L_STK_GET(args, idx), K2L_UNDEF);
		env_put_symbol(dyn, sym);
		sexp_ref_down(sym);
	}
	return idx;
}

static void normalize_lambda_list(k2l_sexp_ref def, k2l_sexp_ref *sym, k2l_sexp_ref *ini)
{ // used to process lambda-list &OPTIONAL/&KEY
	*sym = is_symbol(def) ? def: CONS_CAR(def);
	*ini = (is_symbol(def) || 2 != list_len(def)) ? K2L_NIL: CONS_SECOND(def);
}

static k2l_sexp_ref bind_lambda_list_optional(k2l_sexp_ref dyn, k2l_sexp_ref *adef, k2l_sexp_ref args, k2l_int *idx)
{
	k2l_int len = K2L_STK_LEN(args);
	if (!is_cons(*adef) || CONS_CAR(*adef).w != SYSPRIV_AND_OPTIONAL.w) return K2L_NIL;
	for (*adef = CONS_CDR(*adef); is_cons(*adef) && !is_syspriv(CONS_CAR(*adef)); *adef = CONS_CDR(*adef)) {
		k2l_sexp_ref sym, ini;
		normalize_lambda_list(CONS_CAR(*adef), &sym, &ini);
		sym = new_symbol(SYMBOL_NAME(sym), K2L_UNDEF, K2L_UNDEF);
		if (*idx < len) {
			SYMBOL_VALUE(sym) = sexp_ref_up(K2L_STK_GET(args, (*idx)++));
		} else {
			k2l_sexp_ref tmp = k2l_eval(ENV_PARENT(dyn), ini, NULL);
			if (is_longjmp(tmp)) { sexp_ref_down(sym); return tmp; }
			SYMBOL_VALUE(sym) = tmp;
		}
		env_put_symbol(dyn, sym); sexp_ref_down(sym);
	}
	if (is_nil(*adef) && *idx < len) return K2L_UNDEF;
	return K2L_NIL;
}

static void bind_lambda_list_rest(k2l_sexp_ref dyn, k2l_sexp_ref *adef, k2l_sexp_ref args, k2l_int idx)
{
	if (!is_cons(*adef) || CONS_CAR(*adef).w != SYSPRIV_AND_REST.w) return;
	*adef = CONS_CDR(*adef);
	k2l_int len = K2L_STK_LEN(args);
	k2l_sexp_ref tmp = K2L_NIL, *ptmp = &tmp;
	for (; idx < len; idx++, ptmp = &CONS_CDR(*ptmp)) *ptmp = new_cons(K2L_STK_GET(args, idx), K2L_NIL);
	k2l_sexp_ref sym = new_symbol(SYMBOL_NAME(CONS_CAR(*adef)), tmp, K2L_UNDEF);
	*adef = CONS_CDR(*adef);
	env_put_symbol(dyn, sym); sexp_ref_down(sym);
}

static k2l_sexp_ref bind_lambda_list_key(k2l_sexp_ref dyn, k2l_sexp_ref *adef, k2l_sexp_ref args, k2l_int idx)
{
	k2l_int i, len = K2L_STK_LEN(args);
	if (!is_cons(*adef) || CONS_CAR(*adef).w != SYSPRIV_AND_KEY.w) return K2L_NIL;
	for (*adef = CONS_CDR(*adef); is_cons(*adef); *adef = CONS_CDR(*adef)) {
		k2l_sexp_ref sym, ini;
		normalize_lambda_list(CONS_CAR(*adef), &sym, &ini);
		sym = new_symbol(SYMBOL_NAME(sym), K2L_UNDEF, K2L_UNDEF);
		for (i = idx; i + 1 < len; i += 2) {
			if (stringeq(SYMBOL_NAME(sym), SYMBOL_NAME(K2L_STK_GET(args, i)))) {
				SYMBOL_VALUE(sym) = sexp_ref_up(K2L_STK_GET(args, i+1));
				break;
			}
		}
		if (is_undef(SYMBOL_VALUE(sym))) {
			k2l_sexp_ref tmp = k2l_eval(ENV_PARENT(dyn), ini, NULL);
			if (is_longjmp(tmp)) { sexp_ref_down(sym); return tmp; }
			SYMBOL_VALUE(sym) = tmp;
		}
		env_put_symbol(dyn, sym); sexp_ref_down(sym);
	}
	return K2L_NIL;
}

static k2l_sexp_ref progn(k2l_sexp_ref env, k2l_sexp_ref args, k2l_int ofs, k2l_sexp_ref *mvp)
{
	k2l_int idx, len = K2L_STK_LEN(args);
	k2l_sexp_ref r = K2L_NIL;
	for (idx = ofs; idx < len && !is_longjmp(r); idx++) {
		sexp_ref_down(r);
		if (mvp) sexp_ref_down(*mvp);
		r = k2l_eval(env, K2L_STK_GET(args, idx), mvp);
	}
	return r;
}

k2l_sexp_ref invoke_lambdafn(k2l_sexp_ref fn, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref dyn = new_env(LAMBDA_LEX(fn)), adef = K2L_STK_GET(LAMBDA_DEF(fn), 0);
	k2l_int idx = bind_lambda_list_mandatory(dyn, &adef, args);
	if (idx < 0) { sexp_ref_down(dyn); K2L_RETURN_ABORT("invoke_lambdafn: invalid arguments\n"); }
	k2l_sexp_ref tmp = bind_lambda_list_optional(dyn, &adef, args, &idx);
	if (is_longjmp(tmp)) { sexp_ref_down(dyn); return tmp; }
	if (is_undef(tmp)) {
		sexp_ref_down(dyn); K2L_RETURN_ABORT("invoke_lambdafn: invalid arguments\n");
	}
	bind_lambda_list_rest(dyn, &adef, args, idx);
	tmp = bind_lambda_list_key(dyn, &adef, args, idx);
	if (is_longjmp(tmp)) { sexp_ref_down(dyn); return tmp; }
	k2l_sexp_ref res = progn(dyn, LAMBDA_DEF(fn), 1, mvp);
	sexp_ref_down(dyn);
	return res;
}
k2l_type_callee_t k2l_type_lambdafn = {{&k2l_type_callee_base, SYMTAB_REF(K2L_SYM_LAMBDAsFUNCTION), del_lambdafn, NULL}, invoke_lambdafn};
k2l_type_callee_t k2l_type_macro    = {{&k2l_type_callee_base, SYMTAB_REF(K2L_SYM_MACROsFUNCTION), del_lambdafn, NULL}, invoke_lambdafn};

k2l_sexp_ref new_macro(k2l_sexp_ref env, k2l_sexp_ref name, k2l_sexp_ref def)
{
	k2l_sexp_ref r = new_lambdafn(env, name, def);
	SOBJ_TYPE(r) = &k2l_type_macro.suqer;
	return r;
}

k2l_sexp_ref new_list(k2l_u32 len, ...)
{
	va_list ap;
	va_start(ap, len);
	k2l_sexp_ref r = K2L_NIL;
	k2l_sexp_ref *rp = &r;
	while (len--) {
		*rp = new_cons(va_arg(ap, k2l_sexp_ref), K2L_NIL);
		rp = &CONS_CDR(*rp);
	}
	va_end(ap);
	return r;
}

k2l_sexp_ref k2l_eval(k2l_sexp_ref env, k2l_sexp_ref p, k2l_sexp_ref *mvp)
{ // !!! we shall check is_longjmp after return from k2l_eval !!!
	if (is_symbol(p) && !is_keyword(p)) {
		p = sexp_ref_down(env_find_symbol_by_name(env, SYMBOL_NAME(p)));
		if (is_nil(p) || is_undef(SYMBOL_VALUE(p))) {
			K2L_RETURN_ABORT("eval: symbol has not value");
		}
		return sexp_ref_up(SYMBOL_VALUE(p));
	}
	if (!is_cons(p)) {
		return sexp_ref_up(p);
	}
	k2l_sexp_ref fn;
	{ // create/retrieve fn
		k2l_sexp_ref op = CONS_CAR(p);
		if (is_cons(op) && CONS_CAR(op).w == SYMTAB_REF(K2L_SYM_LAMBDA).w) {
			fn = ___lambda(env, CONS_CDR(op), NULL);
		} else if (is_symbol(op)) {
			if (op.w != SYMTAB_REF(K2L_SYM_LAMBDA).w && !is_keyword(op)) {
				op = sexp_ref_down(env_find_symbol_by_name(env, SYMBOL_NAME(op)));
			}
			fn = sexp_ref_up(SYMBOL_FUNCTION(op));
			if (is_undef(fn) || (!is_function(fn) && !is_lambdafn(fn) && !is_specialop(fn) && !is_macro(fn))) {
				K2L_RETURN_ABORT("eval: symbol has not function");
			}
		} else K2L_RETURN_ABORT("eval: first is not function");
	}
	DECLARE_STACK(s_args, 5);
	k2l_sexp_ref args_e = K2L_CAST(&s_args);
	{ // create args_e
		k2l_int idx = 0;
		k2l_sexp_ref args = CONS_CDR(p);
		for (; is_cons(args); args = CONS_CDR(args), idx++) {
			if (is_callee(fn)) {
				k2l_sexp_ref a = k2l_eval(env, CONS_CAR(args), NULL);
				if (is_longjmp(a)) {
					sexp_ref_down(fn); sexp_ref_down(args_e); CLEAR_STACK(args_e);
					return a;
				}
				k2l_vector_set(args_e, idx, a);
				sexp_ref_down(a);
			} else k2l_vector_set(args_e, idx, CONS_CAR(args));
		}
	}
	if ((is_specialop(fn) && k2l_check_arity(args_e, SPECIALOP_SIG(fn))) ||
		(is_function(fn)  && k2l_check_arity(args_e, FUNCTION_SIG(fn)))) {
		CLEAR_STACK(args_e); sexp_ref_down(fn); sexp_ref_down(args_e); K2L_RETURN_ABORT("EVAL: arity check failure");
	}
	k2l_sexp_ref res;
	if (is_macro(fn)) {
		k2l_sexp_ref tmp = EXPAND_MACRO(fn, args_e);
		res = k2l_eval(env, tmp, mvp);
		sexp_ref_down(tmp);
	} else if (is_specialop(fn)){
		res = INVOKE_SPECIALOP(fn, env, args_e, mvp);
	} else res = APPLY(fn, args_e, mvp);
	sexp_ref_down(fn); sexp_ref_down(args_e); CLEAR_STACK(args_e);
	return res;
}

static k2l_sexp_ref ___add(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_int idx, ret = 0, len = K2L_STK_LEN(args);
	for (idx = 0; idx < len; idx++) {
		k2l_sexp_ref i = K2L_STK_GET(args, idx);
		if (!is_imm_int(i)) K2L_RETURN_ABORT("+: not integer");
		ret += imm_int(i);
	}
	return i2ps(ret);
}

static k2l_sexp_ref ___sub(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	int idx, len = K2L_STK_LEN(args);
	k2l_sexp_ref tmp = K2L_STK_GET(args, 0);
	if (!is_imm_int(tmp)) K2L_RETURN_ABORT("___sub: invalid arguments");
	if (len == 1) return i2ps(-1 * imm_int(tmp));
	int i = imm_int(tmp);
	for (idx = 1; idx < len; idx++) {
		tmp = K2L_STK_GET(args, idx);
		if (!is_imm_int(tmp)) K2L_RETURN_ABORT("-: not integer");
		i -= imm_int(tmp);
	}
	return i2ps(i);
}

static k2l_sexp_ref ___mul(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	int idx, val = 1, len = K2L_STK_LEN(args);
	for (idx = 0; idx < len; idx++) {
		k2l_sexp_ref tmp = K2L_STK_GET(args, idx);
		if (!is_imm_int(tmp)) K2L_RETURN_ABORT("*: not integer");
		val *= imm_int(tmp);
	}
	return i2ps(val);
}

static k2l_sexp_ref ___div(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = K2L_STK_GET(args, 0), b = K2L_STK_GET(args, 1);
	if (!is_imm_int(a) || !is_imm_int(b)) K2L_RETURN_ABORT("/: not integer\n");
	return i2ps(imm_int(a)/imm_int(b));
}

static k2l_sexp_ref ___mod(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = K2L_STK_GET(args, 0), b = K2L_STK_GET(args, 1);
	if (!is_imm_int(a) || !is_imm_int(b)) K2L_RETURN_ABORT("___mod: not integer\n");
	return i2ps(imm_int(a)%imm_int(b));
}

static k2l_sexp_ref ___less(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref tmp = K2L_STK_GET(args, 0);
	if (!is_imm_int(tmp)) K2L_RETURN_ABORT("<: not integer");
	k2l_int idx, i = imm_int(tmp), len = K2L_STK_LEN(args);
	for (idx = 1; idx < len; idx++) {
		tmp = K2L_STK_GET(args, idx);
		if (!is_imm_int(tmp)) K2L_RETURN_ABORT("<: not integer");
		if (i >= imm_int(tmp)) return K2L_NIL;
		i = imm_int(tmp);
	}
	return g_k2l_t;
}

static k2l_sexp_ref ___greater(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref tmp = K2L_STK_GET(args, 0);
	if (!is_imm_int(tmp)) K2L_RETURN_ABORT(">: not integer");
	k2l_int idx, i = imm_int(tmp), len = K2L_STK_LEN(args);
	for (idx = 1; idx < len; idx++) {
		tmp = K2L_STK_GET(args, idx);
		if (!is_imm_int(tmp)) K2L_RETURN_ABORT(">: not integer");
		if (i <= imm_int(tmp)) return K2L_NIL;
		i = imm_int(tmp);
	}
	return g_k2l_t;
}

static k2l_sexp_ref ___car(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref c = K2L_STK_GET(args, 0);
	if (is_nil(c)) return K2L_NIL;
	if (!is_cons(c)) K2L_RETURN_ABORT("CAR: not cons");
	return sexp_ref_up(CONS_CAR(c));
}

static k2l_sexp_ref ___cdr(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref c = K2L_STK_GET(args, 0);
	if (is_nil(c)) return K2L_NIL;
	if (!is_cons(c)) K2L_RETURN_ABORT("CDR: not cons");
	return sexp_ref_up(CONS_CDR(c));
}

static k2l_sexp_ref ___nth(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = K2L_STK_GET(args, 0), b = K2L_STK_GET(args, 1);
	if (!is_list(a)) K2L_RETURN_ABORT("NTH: argument 1 should be list");
	if (!is_imm_int(b)) K2L_RETURN_ABORT("NTH: argument 2 should be integer");
	return nth(a, imm_int(b));
}

static k2l_sexp_ref ___nthcdr(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = K2L_STK_GET(args, 0), b = K2L_STK_GET(args, 1);
	if (!is_list(a)) K2L_RETURN_ABORT("NTHCDR: argument 1 should be list");
	if (!is_imm_int(b)) K2L_RETURN_ABORT("NTHCDR: argument 2 should be integer");
	return nthcdr(a, imm_int(b));
}

static k2l_sexp_ref ___eq(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref i = K2L_STK_GET(args, 0);
	k2l_int idx, len = K2L_STK_LEN(args);
	for (idx = 0; idx < len; idx++) 
		if (i.w != K2L_STK_GET(args, idx).w) return K2L_NIL;
	return g_k2l_t;
}

static k2l_sexp_ref ___not(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return is_nil(K2L_STK_GET(args, 0))? g_k2l_t: K2L_NIL; }
static k2l_sexp_ref ___cons(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return new_cons(K2L_STK_GET(args, 0), K2L_STK_GET(args, 1)); }
static k2l_sexp_ref ___quote(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return sexp_ref_up(K2L_STK_GET(args, 0)); }

static k2l_sexp_ref ___if(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	int len = K2L_STK_LEN(args);
	k2l_sexp_ref _bool = k2l_eval(env, K2L_STK_GET(args, 0), NULL);
	if (is_longjmp(_bool)) {
		return _bool;
	}
	if (!is_nil(_bool)) {
		sexp_ref_down(_bool);
		return k2l_eval(env, K2L_STK_GET(args, 1), mvp);
	}
	return len == 3 ? k2l_eval(env, K2L_STK_GET(args, 2), mvp) : K2L_NIL;
}

static k2l_sexp_ref ___setq(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	int idx, len = K2L_STK_LEN(args);
	if (len%2) K2L_RETURN_ABORT("SETQ: invalid arguments");
	k2l_sexp_ref ret = K2L_NIL;
	for (idx = 0; idx < len; idx++) {
		k2l_sexp_ref sym = K2L_STK_GET(args, idx);
		if (!is_symbol(sym) || is_keyword(sym)) K2L_RETURN_ABORT("SETQ: invalid target");
		sym = sexp_ref_down(env_find_symbol_by_name(env, SYMBOL_NAME(sym)));
		k2l_sexp_ref val = K2L_STK_GET(args, ++idx);
		ret = k2l_eval(env, val, NULL);
		if (is_longjmp(ret)) return ret;
		sexp_ref_down(SYMBOL_VALUE(sym));
		SYMBOL_VALUE(sym) = ret;
	}
	return sexp_ref_up(ret);
}

static k2l_sexp_ref ___eval(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return k2l_eval(K2L_NIL, K2L_STK_GET(args, 0), mvp); }

static k2l_sexp_ref ___stringeq(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = K2L_STK_GET(args, 0), b = K2L_STK_GET(args, 1);
	if (!is_string(a) || !is_string(b)) K2L_RETURN_ABORT("STRING=: all arguments should be STRING");
	return (stringeq(a, b)? g_k2l_t: K2L_NIL);
}

static k2l_sexp_ref ___memcnt(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return i2ps(memcnt); }

static k2l_sexp_ref ___progn(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return progn(env, args, 0, mvp); }

static k2l_sexp_ref ___println(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref stream = (K2L_STK_LEN(args) == 2) ? K2L_STK_GET(args, 1) : K2L_STDOUT;
	k2l_disp_line(K2L_STK_GET(args, 0), stream);
	return sexp_ref_up(K2L_STK_GET(args, 0));
}

static k2l_sexp_ref ___consp(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return is_cons(K2L_STK_GET(args, 0))? g_k2l_t: K2L_NIL; }
static k2l_sexp_ref ___functionp(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return is_callee(K2L_STK_GET(args, 0))? g_k2l_t: K2L_NIL; }
static k2l_sexp_ref ___symbolp(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return is_nil_or_t_or_symbol(K2L_STK_GET(args, 0))? g_k2l_t: K2L_NIL; }
static k2l_sexp_ref ___integerp(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return is_imm_int(K2L_STK_GET(args, 0))? g_k2l_t: K2L_NIL; }
static k2l_sexp_ref ___characterp(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return is_imm_char(K2L_STK_GET(args, 0))? g_k2l_t: K2L_NIL; }
static k2l_sexp_ref ___stringp(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return is_string(K2L_STK_GET(args, 0))? g_k2l_t: K2L_NIL; }

static k2l_sexp_ref ___while_a(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	for (;;) {
		k2l_sexp_ref res = progn(env, args, 0, NULL);
		if (is_longjmp(res)) return res;			
		sexp_ref_down(res);
	}
}

static k2l_sexp_ref bind_symbol(k2l_sexp_ref (*fn)(k2l_sexp_ref,k2l_sexp_ref), k2l_sexp_ref dyn, k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref bnds = K2L_STK_GET(args, 0);
	for (; is_cons(bnds); bnds = CONS_CDR(bnds)) {
		k2l_sexp_ref sym = fn(CONS_CAR(bnds), env);
		if (is_longjmp(sym)) return sym;
		env_put_symbol(dyn, sym);
		sexp_ref_down(sym);
	}
	return progn(dyn, args, 1, mvp);
}

static k2l_sexp_ref bound_symbol_value(k2l_sexp_ref a, k2l_sexp_ref env)
{
	if (is_symbol(a)) {
		return new_symbol(SYMBOL_NAME(a), K2L_NIL, K2L_UNDEF);
	}
	k2l_sexp_ref val = K2L_NIL;
	if (2 <= list_len(a)) val = k2l_eval(env, CONS_SECOND(a), NULL);
	if (is_longjmp(val)) {
		return val;
	}
	k2l_sexp_ref sym = new_symbol(SYMBOL_NAME(CONS_CAR(a)), val, K2L_UNDEF);
	sexp_ref_down(val);
	return sym;
}

static k2l_sexp_ref bound_symbol_function(k2l_sexp_ref a, k2l_sexp_ref env)
{
	k2l_sexp_ref sym = new_symbol(SYMBOL_NAME(CONS_CAR(a)), K2L_UNDEF, K2L_UNDEF);
	SYMBOL_FUNCTION(sym) = new_lambdafn(env, SYMBOL_NAME(sym), CONS_CDR(a));
	return sym;
}

static k2l_sexp_ref bound_symbol_macro(k2l_sexp_ref a, k2l_sexp_ref env)
{
	k2l_sexp_ref sym = new_symbol(SYMBOL_NAME(CONS_CAR(a)), K2L_UNDEF, K2L_UNDEF);
	SYMBOL_FUNCTION(sym) = new_macro(env, SYMBOL_NAME(sym), CONS_CDR(a));
	return sym;
}

static k2l_sexp_ref ___macrolet(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref dyn = new_env(env);
	k2l_sexp_ref res = bind_symbol(bound_symbol_macro, dyn, env, args, mvp);
	sexp_ref_down(dyn);
	return res;
}

static k2l_sexp_ref ___let(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref dyn = new_env(env);
	k2l_sexp_ref res = bind_symbol(bound_symbol_value, dyn, env, args, mvp);
	sexp_ref_down(dyn);
	return res;
}

static k2l_sexp_ref ___let_a(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref dyn = new_env(env);
	k2l_sexp_ref res = bind_symbol(bound_symbol_value, dyn, dyn, args, mvp);
	sexp_ref_down(dyn);
	return res;
}

static k2l_sexp_ref ___labels(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref dyn = new_env(env);
	k2l_sexp_ref res = bind_symbol(bound_symbol_function, dyn, env, args, mvp);
	sexp_ref_down(dyn);
	return res;
}

static k2l_sexp_ref ___flet(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref dyn = new_env(env);
	k2l_sexp_ref res = bind_symbol(bound_symbol_function, dyn, dyn, args, mvp);
	sexp_ref_down(dyn);
	return res;
}

static k2l_sexp_ref ___lambda(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref tmp = SEQ_SUBSEQ(args, 0, SEQ_LENGTH(args));
	k2l_sexp_ref ret = new_lambdafn(env, SYMBOL_NAME(SYMTAB_REF(K2L_SYM_LAMBDA)), tmp);
	sexp_ref_down(tmp); return ret;
}

static k2l_sexp_ref ___defun_a(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref sym = K2L_STK_GET(args, 0), def = SEQ_SUBSEQ(args, 1, SEQ_LENGTH(args) - 1);
	k2l_sexp_ref fn = new_lambdafn(env, SYMBOL_NAME(sym), def);
	sexp_ref_down(SYMBOL_FUNCTION(sym)); sexp_ref_down(def);
	SYMBOL_FUNCTION(sym) = fn;
	return sexp_ref_up(sym);
}

static k2l_sexp_ref ___defmacro_a(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref sym = K2L_STK_GET(args, 0), def = SEQ_SUBSEQ(args, 1, SEQ_LENGTH(args) - 1);
	k2l_sexp_ref fn = new_macro(env, SYMBOL_NAME(sym), def);
	sexp_ref_down(SYMBOL_FUNCTION(sym)); sexp_ref_down(def);
	SYMBOL_FUNCTION(sym) = fn;
	return sexp_ref_up(sym);
}

static k2l_sexp_ref ___macroexpand(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = K2L_STK_GET(args, 0);
	return EXPAND_MACRO(SYMBOL_FUNCTION(CONS_CAR(a)), CONS_CDR(a));
}

static k2l_sexp_ref ___apply(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_int idx, len = K2L_STK_LEN(args);
	k2l_sexp_ref fn = K2L_STK_GET(args, 0);
	DECLARE_STACK(s_stack, 5);
	k2l_sexp_ref tmp, stack = K2L_CAST(&s_stack);
	if (!is_callee(fn)) K2L_RETURN_ABORT("APPLY: argument 1 should be function");
	for (idx = 1; idx < len - 1; idx++)
		k2l_vector_set(stack, idx - 1, K2L_STK_GET(args, idx));
	if (len > 1) {
		tmp = K2L_STK_GET(args, idx);
		if (!is_list(tmp)) {
			CLEAR_STACK(stack); K2L_RETURN_ABORT("APPLY: last argument should be list");
		}
		for (; is_cons(tmp); tmp = CONS_CDR(tmp), idx++)
			k2l_vector_set(stack, idx - 1, CONS_CAR(tmp));
	}
	if (is_function(fn) && k2l_check_arity(stack, FUNCTION_SIG(fn))) {
		CLEAR_STACK(stack); K2L_RETURN_ABORT("APPLY: arity check failure");
	}
	k2l_sexp_ref ret = APPLY(fn, stack, mvp);
	CLEAR_STACK(stack);
	return ret;
}

static k2l_sexp_ref ___list(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref ret = K2L_NIL, *pret = &ret;
	k2l_int idx, len = K2L_STK_LEN(args);
	for (idx = 0; idx < len; idx++, pret = &CONS_CDR(*pret))
		*pret = new_cons(K2L_STK_GET(args, idx), K2L_NIL);
	return ret;
}

static k2l_sexp_ref ___make_hash_table(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return new_hashtab(imm_int(K2L_STK_GET(args, 0))); }

static k2l_sexp_ref ___gethash(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = K2L_STK_GET(args, 0), b = K2L_STK_GET(args, 1), stg = is_symbol(a)? SYMBOL_NAME(a): a;
	if (!is_string(stg)) K2L_RETURN_ABORT("GETHASH: argument 1 should be string or symbol");
	if (!is_hashtab(b)) K2L_RETURN_ABORT("GETHASH: argument 2 should be hashtable");
	k2l_sexp_ref ret = hashtab_get(b, stg);
	if (is_undef(ret)) {
		if (mvp) *mvp = new_cons(K2L_NIL, K2L_NIL);
		return K2L_NIL;
	}
	return ret;
}

static k2l_sexp_ref ___puthash(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = K2L_STK_GET(args, 0), b = K2L_STK_GET(args, 1), stg = is_symbol(b)? SYMBOL_NAME(b): b;
	if (!is_hashtab(a)) K2L_RETURN_ABORT("PUTHASH: argument 1 should be hashtable");
	if (!is_string(stg)) K2L_RETURN_ABORT("PUTHASH: argument 2 should be string or symbol");
	k2l_sexp_ref res = K2L_STK_GET(args, 2);
	hashtab_put(a, stg, res);
	return sexp_ref_up(res);
}

static k2l_sexp_ref ___time(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	struct timeval tv1, tv2;
	struct timezone tz;
	gettimeofday(&tv1, &tz);
	k2l_sexp_ref tmp = k2l_eval(K2L_NIL, K2L_STK_GET(args, 0), NULL);
	if (is_longjmp(tmp)) return tmp;
	sexp_ref_down(tmp);
	gettimeofday(&tv2, &tz);
	if (tv1.tv_sec == tv2.tv_sec) {
		return i2ps(tv2.tv_usec-tv1.tv_usec);
	}
	int i = (1000000 - tv1.tv_usec) + tv2.tv_usec + 1000000 * (tv2.tv_sec - (tv1.tv_sec + 1));
	return i2ps(i);
}

static k2l_sexp_ref ___return_from(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = K2L_STK_GET(args, 0);
	if (!is_nil_or_t_or_symbol(a)) K2L_RETURN_ABORT("RETURN-FROM: name is not symbol");
	k2l_sexp_ref res = (1 == list_len(args)) ?
		K2L_NIL: k2l_eval(env, K2L_STK_GET(args, 1), NULL);
	if (is_longjmp(res)) {
		return res;
	}
	SYS_PRIVP(retblk) = new_cons(a, res);
	sexp_ref_down(res);
	return retblk;
}

static k2l_sexp_ref ___block(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref nam = K2L_STK_GET(args, 0);
	if (!is_nil_or_t_or_symbol(nam)) K2L_RETURN_ABORT("BLOCK: name is not symbol");
	k2l_sexp_ref res = progn(env, args, 1, mvp);
	if (retblk.w == res.w) {
		k2l_sexp_ref p = SYS_PRIVP(retblk);
		if (nam.w == CONS_CAR(p).w || stringeq(SYMBOL_NAME(nam), SYMBOL_NAME(CONS_CAR(p)))) {
			res = sexp_ref_up(CONS_CDR(p));
			sexp_ref_down(p);
		}
	}
	return res;
}

static k2l_sexp_ref ___go(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	SYS_PRIVP(gotagb) = sexp_ref_up(SYMBOL_NAME(K2L_STK_GET(args, 0)));
	return gotagb;
}

static k2l_sexp_ref ___tagbody(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref ret = K2L_NIL, tmp, tab = new_hashtab(5);
	k2l_int idx, len = K2L_STK_LEN(args);
	for (idx = 0; idx < len; idx++)
		if (is_symbol(tmp = K2L_STK_GET(args, idx))) hashtab_put(tab, SYMBOL_NAME(tmp), i2ps(idx+1));
	for (idx = 0; idx < len && !is_longjmp(tmp); idx++) {
		sexp_ref_down(ret);
		tmp = K2L_STK_GET(args, idx);
		if (is_cons(tmp) && (ret = k2l_eval(env, tmp, NULL)).w == gotagb.w) {
			tmp = sexp_ref_down(hashtab_get(tab, SYS_PRIVP(gotagb)));
			if (!is_undef(tmp)) {
				idx = imm_int(tmp) - 1;
				sexp_ref_down(SYS_PRIVP(gotagb));
				SYS_PRIVP(gotagb) = K2L_UNDEF;
			}
		}
	}
	sexp_ref_down(tab);
	return ret;
}

static k2l_sexp_ref ___values(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	if (mvp) {
		k2l_sexp_ref subs = SEQ_SUBSEQ(args, 1, K2L_STK_LEN(args)-1);
		*mvp = ___list(subs, NULL); sexp_ref_down(subs);
	}
	return sexp_ref_up(K2L_STK_GET(args, 0));
}

static k2l_sexp_ref ___multiple_value_call(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_int idx, len = K2L_STK_LEN(args);
	k2l_sexp_ref fn = k2l_eval(env, K2L_STK_GET(args, 0), NULL);
	k2l_sexp_ref args_e = K2L_NIL, *args_ep = &args_e;
	if (is_longjmp(fn)) return fn;
	if (!is_callee(fn)) K2L_RETURN_ABORT("MULTIPLE-VALUE-CALL: argument 1 should be function");
	for (idx = 1; idx < len; idx++) {
		k2l_sexp_ref mv = K2L_UNDEF;
		k2l_sexp_ref a = k2l_eval(env, K2L_STK_GET(args, idx), &mv);
		if (is_longjmp(a)) {
			sexp_ref_down(mv); sexp_ref_down(fn);
			return a;
		}
		*args_ep = new_cons(a, (is_undef(mv)? K2L_NIL: mv));
		sexp_ref_down(a); sexp_ref_down(mv);
		while (!is_nil(*args_ep)) args_ep = &CONS_CDR(*args_ep);
	}
	k2l_sexp_ref res = APPLY(fn, args_e, mvp);
	sexp_ref_down(fn); sexp_ref_down(args_e);
	return res;
}

static k2l_sexp_ref ___function(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref sym = K2L_STK_GET(args, 0);
	if (!is_keyword(sym)) {
		sym = sexp_ref_down(env_find_symbol_by_name(env, SYMBOL_NAME(sym)));
	}
	return sexp_ref_up(SYMBOL_FUNCTION(sym));
}

static k2l_sexp_ref ___type_of(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return sexp_ref_up(K2L_TYPE(K2L_STK_GET(args, 0))->sig); }

k2l_int k2l_typep(k2l_sexp_ref obj, k2l_type_t *type)
{
	k2l_type_t *p = K2L_TYPE(obj);
	for (;p; p=p->parent) if (p == type) return 1;
	return 0;
}

static k2l_sexp_ref ___typep(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_type_t *p = K2L_TYPE(K2L_STK_GET(args, 0));
	k2l_sexp_ref sig = K2L_STK_GET(args, 1);
	for (;p ; p=p->parent) if (p->sig.w == sig.w) return g_k2l_t;
	return K2L_NIL;
}

typedef enum {
	SYX_CONSTITUENT, SYX_WHITESPACE, SYX_INVALID, SYX_SINGLE_ESCAPE,
	SYX_MULTI_ESCAPE, SYX_TERMINATE, SYX_NONTERMINATE,
} chr_syx_e;

#define RT_TOKEN_BUFSZ 256
#define READ_STRING_BUFSZ 256

static chr_syx_e syxtab[];
static k2l_sexp_ref rmtab[];

static int token_is_int(char* buf, int len)
{
	while (len--) {
		if (*buf < '0' || *buf > '9') return 0;
		buf++;
	}
	return 1;
}

static k2l_sexp_ref tokenize(k2l_sexp_ref env, char* buf, int len)
{
	buf[len] = 0;
	if (token_is_int(buf, len))                           return i2ps(atoi(buf));
	if (len == 1 && buf[0] == '.')                        return SYSPRIV_CONS_DOT;
	if (len == 1 && buf[0] == 'T')                        return g_k2l_t;
	if (len == 3 && strncmp(buf, "NIL", 3) == 0)          return K2L_NIL;
	if (len == 5 && strncmp(buf, "&REST", 5) == 0)        return SYSPRIV_AND_REST;
	if (len == 4 && strncmp(buf, "&KEY", 4) == 0)         return SYSPRIV_AND_KEY;
	if (len == 9 && strncmp(buf, "&OPTIONAL", 9) == 0)    return SYSPRIV_AND_OPTIONAL;
	if (buf[0] == ':') {
		k2l_sexp_ref a = new_string(buf+1);
		k2l_sexp_ref sym = keyword_find_symbol_by_name(a);
		if (is_undef(sym)) {
			sym = keyword_put_symbol(a);
		}
		sexp_ref_down(a);
		return sym;
	}
	k2l_sexp_ref s = new_string(buf);
	k2l_sexp_ref r = env_find_symbol_by_name(env, s);
	if (is_undef(r)) {
		r = new_symbol(s, K2L_UNDEF, K2L_UNDEF);
		env_put_symbol(K2L_NIL, r);
	}
	sexp_ref_down(s);
	return r;
}

static void input_reset(k2l_sexp_ref is)
{ FIS_MARK(is)++; }

static k2l_char input_read_char(k2l_sexp_ref is)
{
	if (FIS_MARK(is) == 0 && 0 == read(FIS_FD(is), &FIS_BUF(is), 1)) {
		FIS_BUF(is) = -1;
	}
	if (FIS_MARK(is) == 0 || FIS_MARK(is) == 1) {
		FIS_MARK(is) = 0;
		return FIS_BUF(is);
	} else K2L_ABORT("input_read_char: never come here\n");
}

k2l_sexp_ref k2l_read(k2l_sexp_ref env, k2l_sexp_ref p)
{
	k2l_u32 i;
	char buf[RT_TOKEN_BUFSZ];
	int ofs = 0, in_multi = 0;

	for (;;) {
		i = STREAM_GETCHAR(p);
		if (i == -1) return SYSPRIV_END_OF_FILE;
		if (i >= 0 && i < 128) {
			switch (syxtab[i]) {
			case SYX_WHITESPACE:
				if (ofs == 0) continue;
				if (!in_multi) {
					STREAM_RESET(p);
					return tokenize(env, buf, ofs);
				}
				break;
			case SYX_INVALID:
				K2L_RETURN_ABORT("READ: invalid character");
			case SYX_SINGLE_ESCAPE:
				i = STREAM_GETCHAR(p);
				if (i == -1) return SYSPRIV_END_OF_FILE;
				break;
			case SYX_MULTI_ESCAPE:
				in_multi = !in_multi;
				continue;
			case SYX_TERMINATE:
				if (ofs == 0 || in_multi) {
					k2l_sexp_ref args = new_list(2, p, c2ps(i));
					k2l_sexp_ref ret = (FUNCTION(rmtab[i]))(args, NULL);
					sexp_ref_down(args);
					return ret;
				}
				if (!in_multi) {
					STREAM_RESET(p);
					return tokenize(env, buf, ofs);
				}
				break;
			case SYX_NONTERMINATE:
				if (ofs == 0) {
					k2l_sexp_ref args = new_list(2, p, c2ps(i));
					k2l_sexp_ref ret = (FUNCTION(rmtab[i]))(args, NULL);
					sexp_ref_down(args);
					return ret;
				}
			case SYX_CONSTITUENT:
			default:
				if (!in_multi && i >= 'a' && i <= 'z') {
					i = 'A' + (i - 'a'); // change i to upcase
				}
				break;
			}
			buf[ofs++] = i;
		}
	}
}

static k2l_sexp_ref ___read_list(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref first = CONS_CAR(args);
	k2l_sexp_ref r = K2L_NIL;
	k2l_sexp_ref *rp = &r;

	while (1) {
		k2l_sexp_ref tmp = k2l_read(K2L_NIL, first);
		if (tmp.w == SYSPRIV_END_OF_LIST.w) {
			break;
		}
		if (tmp.w == SYSPRIV_CONS_DOT.w) {
			*rp = k2l_read(K2L_NIL, first);
			if (k2l_read(K2L_NIL, first).w != SYSPRIV_END_OF_LIST.w) {
				sexp_ref_down(r);
				K2L_RETURN_ABORT("read_list: not end of list\n");
			}
			break;
		}
		*rp = new_cons(tmp, K2L_NIL);
		sexp_ref_down(tmp);
		rp = &CONS_CDR(*rp);
	}
	return r;
}

static k2l_sexp_ref ___read_end_of_list(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return SYSPRIV_END_OF_LIST; }

static k2l_sexp_ref ___read_quote(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref a = k2l_read(K2L_NIL, CONS_CAR(args));
	k2l_sexp_ref b = new_list(2, SYMTAB_REF(K2L_SYM_QUOTE), a);
	sexp_ref_down(a);
	return b;
}							  

static k2l_sexp_ref ___read(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref r = k2l_read(K2L_NIL, K2L_STK_GET(args, 0));
	if (is_syspriv(r) && SYSPRIV_END_OF_FILE.w != r.w) {
		abort(); // system handler
	}
	return r;
}

static k2l_sexp_ref ___open_a(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_int fd = open(STRING_HEAD(K2L_STK_GET(args, 0)), O_CREAT|O_RDWR, 0777);
	return new_filedesc(fd);
}

static k2l_sexp_ref ___close_a(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	close(FIS_FD(K2L_STK_GET(args, 0)));
	return g_k2l_t;
}

static k2l_sexp_ref ___read_string(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref fst = CONS_CAR(args);
	char buf[READ_STRING_BUFSZ];
	int ofs = 0;
	while (ofs < READ_STRING_BUFSZ) {
		char c = STREAM_GETCHAR(fst);
		if (c == -1) abort();
		if (c == '"') break;
		buf[ofs++] = c;
	}
	buf[ofs++] = 0;
	return new_string(buf);
}

static k2l_sexp_ref ___read_sharp(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	char c = STREAM_GETCHAR(CONS_CAR(args));
	if (c == '\\') return c2ps(STREAM_GETCHAR(CONS_CAR(args)));
	if (c == '\'') {
		k2l_sexp_ref tmp = k2l_read(K2L_NIL, CONS_CAR(args));
		if (is_symbol(tmp)) {
			k2l_sexp_ref res = new_list(2, SYMTAB_REF(K2L_SYM_FUNCTION), tmp);
			sexp_ref_down(tmp);
			return res;
		} else abort();
	} else abort();
}

static k2l_sexp_ref ___read_backq(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref sexp;
	if (syxtab[','] == SYX_INVALID) {
		syxtab[','] = SYX_TERMINATE;
		sexp = k2l_read(K2L_NIL, CONS_CAR(args));
		syxtab[','] = SYX_INVALID;
	} else {
		sexp = k2l_read(K2L_NIL, CONS_CAR(args));
	}
	k2l_sexp_ref res = new_list(2, SYMTAB_REF(K2L_SYM_BACKQ), sexp);
	sexp_ref_down(sexp);
	return res;
}

static k2l_sexp_ref ___skip_comment(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref stm = K2L_STK_GET(args, 0);
	k2l_char c;
	do { c = STREAM_GETCHAR(stm); } while (c != EOF && c != '\n');
	return c == EOF ? SYSPRIV_END_OF_FILE: k2l_read(K2L_NIL, stm);
}

static k2l_sexp_ref eval_backq(k2l_sexp_ref env, k2l_sexp_ref a)
{
	if (!is_cons(a)) {
		return sexp_ref_up(a);
	}
	if (CONS_CAR(a).w == SYSPRIV_COMMA.w) {
		return k2l_eval(env, CONS_CAR(CONS_CDR(a)), NULL);
	}
	if (CONS_CAR(a).w == SYSPRIV_COMMA_AT.w) {
		abort();
	}
	k2l_sexp_ref r = K2L_NIL;
	k2l_sexp_ref *rp = &r;
	for (; is_cons(a); a = CONS_CDR(a)) {
		k2l_sexp_ref b = CONS_CAR(a);
		if (b.w == SYSPRIV_COMMA.w || b.w == SYSPRIV_COMMA_AT.w) {
			*rp = eval_backq(env, CONS_SECOND(a));
			if (is_longjmp(*rp)) {
				sexp_ref_down(r);
				return *rp;
			}
			return r;
		} else if (!is_cons(b)) {
			*rp = new_cons(b, K2L_NIL);
			rp = &CONS_CDR(*rp);
		} else if (CONS_CAR(b).w == SYSPRIV_COMMA_AT.w) {
			*rp = k2l_eval(env, CONS_CAR(CONS_CDR(b)), NULL);
			if (is_longjmp(*rp)) {
				sexp_ref_down(r);
				return *rp;
			}
			while (is_cons(*rp)) {
				rp = &CONS_CDR(*rp);
			}
		} else {
			k2l_sexp_ref c = eval_backq(env, b);
			if (is_longjmp(c)) {
				sexp_ref_down(r);
				return c;
			}
			*rp = new_cons(c, K2L_NIL);
			rp = &CONS_CDR(*rp);
			sexp_ref_down(c);
		}
	}
	if (!is_nil(a)) {
		*rp = sexp_ref_up(a);
	}
	return r;
}

static k2l_sexp_ref ___backq(k2l_sexp_ref env, k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return eval_backq(env, K2L_STK_GET(args, 0)); }

static k2l_sexp_ref ___read_comma(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref rdr = K2L_STK_GET(args, 0);
	k2l_sexp_ref op = SYSPRIV_COMMA_AT;
	char c = STREAM_GETCHAR(rdr);
	if (c != '@') {
		STREAM_RESET(rdr);
		op = SYSPRIV_COMMA;
	}
	k2l_sexp_ref a = k2l_read(K2L_NIL, rdr);
	k2l_sexp_ref res = new_list(2, op, a);
	sexp_ref_down(a);
	return res;
}

static void k2l_putchar(k2l_sexp_ref self, k2l_char c)
{ write(FIS_FD(self), &c, 1); }

k2l_type_stream_t k2l_type_filedesc = {{&k2l_type_stream_base, SYMTAB_REF(K2L_SYM_FILEsDESCRIPTOR), free_sexp, NULL}, input_read_char, input_reset, k2l_putchar};
k2l_sexp_ref new_filedesc(k2l_int fd)
{
	k2l_sexp_ref r = new_sexp(sizeof(k2l_filedesc_t), &k2l_type_filedesc.suqer);
	FIS_FD(r) = fd;
	return r;
}

static k2l_sexp_ref ___write_char(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref str = (K2L_STK_LEN(args) == 2) ? K2L_STK_GET(args, 1) : K2L_STDOUT;
	STREAM_PUTCHAR(str, imm_char(K2L_STK_GET(args, 0)));
	return sexp_ref_up(K2L_STK_GET(args, 0));
}

static k2l_sexp_ref ___read_char(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref str = K2L_STK_LEN(args)==1? K2L_STK_GET(args, 0): K2L_STDIN;
	k2l_char c = STREAM_GETCHAR(str);
	return c2ps(c);
}

static k2l_sexp_ref ___hash_table_keys(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	k2l_sexp_ref tab = K2L_STK_GET(args, 0), ret = K2L_NIL, *pret = &ret;
	if (!is_hashtab(tab)) K2L_RETURN_ABORT("HASH-TABLE-KEYS: argument 1 should be hashtable");
	int i, len = HASHTAB_LEN(tab);
	for (i = 0; i < len; i++) {
		k2l_hashtab_ent *x = HASHTAB_TAB(tab)[i];
		for (; x; x = x->next, pret = &CONS_CDR(*pret)) *pret = new_cons(K2L_CAST(x->key), K2L_NIL);
	}
	return ret;
}

static k2l_sexp_ref ___selt(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{
	SEQ_SET(K2L_STK_GET(args, 0), imm_int(K2L_STK_GET(args, 1)), K2L_STK_GET(args, 2));
	return sexp_ref_up(K2L_STK_GET(args, 2));
}

static k2l_sexp_ref ___subseq(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return SEQ_SUBSEQ(K2L_STK_GET(args, 0), imm_int(K2L_STK_GET(args, 1)), imm_int(K2L_STK_GET(args, 2))); }
static k2l_sexp_ref ___load(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ k2l_load( STRING_HEAD(K2L_STK_GET(args, 0)) ); return g_k2l_t; }
static k2l_sexp_ref ___symbol_value(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return sexp_ref_up(SYMBOL_VALUE(K2L_STK_GET(args, 0))); }
static k2l_sexp_ref ___symbol_name(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return sexp_ref_up(SYMBOL_NAME(K2L_STK_GET(args, 0))); }
static k2l_sexp_ref ___symbol_function(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return sexp_ref_up(SYMBOL_FUNCTION(K2L_STK_GET(args, 0))); }
static k2l_sexp_ref ___elt(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return SEQ_ELT(K2L_STK_GET(args, 0), imm_int(K2L_STK_GET(args, 1))); }
static k2l_sexp_ref ___length(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return i2ps(SEQ_LENGTH(K2L_STK_GET(args, 0))); }
static k2l_sexp_ref ___make_buffer(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return new_string_buffer(imm_int(K2L_STK_GET(args, 0))); }
static k2l_sexp_ref ___char_code(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return i2ps(imm_char(K2L_STK_GET(args, 0))); }
static k2l_sexp_ref ___code_char(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return c2ps(imm_int(K2L_STK_GET(args, 0))); }
static k2l_sexp_ref ___make_symbol(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return new_symbol(K2L_STK_GET(args, 0), K2L_UNDEF, K2L_UNDEF); }
static k2l_sexp_ref ___vector(k2l_sexp_ref args, k2l_sexp_ref *mvp)
{ return new_vector(imm_int(K2L_STK_GET(args, 0))); }

void k2l_load(k2l_char *file)
{
	k2l_sexp_ref fd = new_filedesc(open(file, O_RDONLY));
	k2l_sexp_ref r, w;
	while (1) {
		r = k2l_read(K2L_NIL, fd);
		if (r.w == SYSPRIV_END_OF_FILE.w) break;
		w = k2l_eval(K2L_NIL, r, NULL);
		sexp_ref_down(r);
		sexp_ref_down(w);
	}
	close(FIS_FD(fd));
	sexp_ref_down(fd);
}

k2l_int k2l_repl(k2l_int argc, k2l_char** argv)
{
	k2l_sexp_ref is = K2L_STDIN;
	if (argc >= 2) {
		k2l_load(argv[1]);
	}
	while (1) {
		printf("> "); fflush(stdout);
		k2l_sexp_ref a = k2l_read(K2L_NIL, is);
		if (a.w == SYSPRIV_END_OF_FILE.w) break;
		k2l_sexp_ref mv = K2L_UNDEF;
		k2l_sexp_ref b = k2l_eval(K2L_NIL, a, &mv);
		sexp_ref_down(a);
		k2l_disp_line(b, K2L_STDOUT);
		if (!is_undef(mv)) {
			k2l_disp_line(mv, K2L_STDOUT);
			sexp_ref_down(mv);
		}
		sexp_ref_down(b);
	}
	return 0;
}

static chr_syx_e syxtab[128] = {
	/* 0x00-0x0F */	SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_WHITESPACE, SYX_WHITESPACE, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_WHITESPACE, SYX_CONSTITUENT, SYX_CONSTITUENT, 
	/* 0x10-0x1F */	SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, 
	/* 0x20-0x2F */	SYX_WHITESPACE, SYX_CONSTITUENT, SYX_TERMINATE, SYX_NONTERMINATE, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_TERMINATE, SYX_TERMINATE, SYX_TERMINATE, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_INVALID, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, 
	/* 0x30-0x3F */	SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_TERMINATE, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, 
	/* 0x40-0x4F */	SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, 
	/* 0x50-0x5F */	SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, 
	/* 0x60-0x6F */	SYX_TERMINATE, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, 
	/* 0x70-0x7F */	SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT, SYX_CONSTITUENT
};

static k2l_sexp_ref rmtab[128] = { // read macro table
#define RMTAB_ELEM(fn) K2L_CAST(&(k2l_function_t)DECLARE_FUNCTION(fn, "m"))
	/* 0x00-0x0F */ K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, 
	/* 0x10-0x1F */ K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, 
	/* 0x20-0x2F */ K2L_NIL, K2L_NIL, RMTAB_ELEM(___read_string), RMTAB_ELEM(___read_sharp), K2L_NIL, K2L_NIL, K2L_NIL, RMTAB_ELEM(___read_quote), RMTAB_ELEM(___read_list), RMTAB_ELEM(___read_end_of_list), K2L_NIL, K2L_NIL, RMTAB_ELEM(___read_comma), K2L_NIL, K2L_NIL, K2L_NIL, 
	/* 0x30-0x3F */ K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, RMTAB_ELEM(___skip_comment), K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, 
	/* 0x40-0x4F */ K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, 
	/* 0x50-0x5F */ K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, 
	/* 0x60-0x6F */ RMTAB_ELEM(___read_backq), K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, 
	/* 0x70-0x7F */ K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, K2L_NIL, 
};

static k2l_symbol_t s_reserved_symtab[] = {
	#include "k2l_symtab.h"
};
static const k2l_int s_reserved_symtab_num = sizeof(s_reserved_symtab)/sizeof(k2l_symbol_t);
